library(fpp2) # 시계열 분석을 위한 패키지
library(gridExtra)
theme_set(theme_grey(base_family='NanumGothic')) # ggplot 한글 깨짐 방지
options(scipen = 999) # to remove scientific notation
전체 스포츠 한 그림에
dir <- "/Users/jaeyonglee/Documents/College/RStudio/Culture/real_proper_ts_data/chungnam/"
items <- c("골프","레저스포츠","스키","자전거","헬스")
# 데이터 불러오기
temp1 <- read.csv(paste(dir,items[1],".csv",sep=""), header=T)
temp2 <- read.csv(paste(dir,items[2],".csv",sep=""), header=T)
temp3 <- read.csv(paste(dir,items[3],".csv",sep=""), header=T)
temp4 <- read.csv(paste(dir,items[4],".csv",sep=""), header=T)
temp5 <- read.csv(paste(dir,items[5],".csv",sep=""), header=T)
# ts 개체로 만들기
temp1_ts <- ts(temp1['avg'][,1], start=2018, frequency=12) # [,1]은 univariate으로 정확히 해주기 위함임
temp2_ts <- ts(temp2['avg'][,1], start=2018, frequency=12)
temp3_ts <- ts(temp3['avg'][,1], start=2018, frequency=12)
temp4_ts <- ts(temp4['avg'][,1], start=2018, frequency=12)
temp5_ts <- ts(temp5['avg'][,1], start=2018, frequency=12)
# 시각화
temp_plot <- autoplot(temp1_ts, series = items[1]) +
autolayer(temp2_ts, series = items[2]) +
autolayer(temp3_ts, series = items[3]) +
autolayer(temp4_ts, series = items[4]) +
autolayer(temp5_ts, series = items[5]) +
labs(title = paste("스포츠 종목별 개인 취급액 시계열 (충청남도)\n",sep=""),
caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수)",
x = "시간",
y = "취급액") +
labs(color='스포츠 종목 구분') +
theme(
plot.title = element_text(hjust = 0.5), # 가운데 정렬
plot.caption = element_text(hjust = 0) # 왼쪽 정렬
)
print(temp_plot)

스포츠 종목별 시계열 분해 및 예측
dir <- "/Users/jaeyonglee/Documents/College/RStudio/Culture/real_proper_ts_data/chungnam/"
items <- c("전체 스포츠활동","골프","레저스포츠","스키","자전거","헬스")
for(item in items){
# 데이터 불러오기
if(item == "전체 스포츠활동"){
temp <- read.csv(paste(dir,"all_sports.csv",sep=""), header=T)
}else{
temp <- read.csv(paste(dir,item,".csv",sep=""), header=T)
}
# ts 개체로 만들기
temp_ts <- ts(temp['avg'][,1], start=2018, frequency=12) # [,1]은 univariate으로 정확히 해주기 위함임
# auto.arima로 최적의 pdq, PDQ 찾기
fit_arima <- auto.arima(temp_ts)
cat(paste(item,"의 개인 취급액 시계열 (충청남도)\n", sep=""))
print(fit_arima)
# residual assumption 확인
checkresiduals(fit_arima)
fit_arima %>% forecast(h=12, level=80) %>% autoplot() +
labs(title = paste(item,"의 개인 취급액 시계열 (충청남도)",sep=""),
subtitle = "미래 1~12개월(1년)에 대한 ARIMA의 예측치와 80% 신뢰구간",
caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수",
x = "시간",
y = "취급액") +
theme(
plot.title = element_text(hjust = 0.5), # 가운데 정렬
plot.subtitle = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0) # 왼쪽 정렬
) -> arima_plot
print(arima_plot)
# STL decomposition
fit_stl <- stl(temp_ts,s.window="periodic", robust=T)
autoplot(fit_stl) +
labs(title = paste(item,"의 개인 취급액 시계열 (충청남도)",sep=""),
subtitle = "STL decomposition",
caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수)",
x = "시간",
y = "취급액") +
theme(
plot.title = element_text(hjust = 0.5), # 가운데 정렬
plot.subtitle = element_text(hjust = 0.5),
plot.caption = element_text(hjust = 0) # 왼쪽 정렬
) -> stl_plot
print(stl_plot)
}
전체 스포츠활동의 개인 취급액 시계열 (충청남도)
Series: temp_ts
ARIMA(0,0,1)(1,1,0)[12]
Coefficients:
ma1 sar1
0.6279 -0.4696
s.e. 0.1256 0.1454
sigma^2 = 303128424448777: log likelihood = -724.38
AIC=1454.76 AICc=1455.43 BIC=1459.83
Ljung-Box test
data: Residuals from ARIMA(0,0,1)(1,1,0)[12]
Q* = 5.2854, df = 8, p-value = 0.7267
Model df: 2. Total lags used: 10
골프의 개인 취급액 시계열 (충청남도)
Series: temp_ts
ARIMA(0,0,0)(1,1,0)[12] with drift
Coefficients:
sar1 drift
-0.4282 421653.54
s.e. 0.1657 66275.48
sigma^2 = 44383662915273: log likelihood = -685.42
AIC=1376.85 AICc=1377.51 BIC=1381.91
Ljung-Box test
data: Residuals from ARIMA(0,0,0)(1,1,0)[12] with drift
Q* = 25.105, df = 8, p-value = 0.001492
Model df: 2. Total lags used: 10
레저스포츠의 개인 취급액 시계열 (충청남도)
Series: temp_ts
ARIMA(0,1,0)
sigma^2 = 56751987114798: log likelihood = -879.94
AIC=1761.89 AICc=1761.97 BIC=1763.82
Ljung-Box test
data: Residuals from ARIMA(0,1,0)
Q* = 14.347, df = 10, p-value = 0.1577
Model df: 0. Total lags used: 10
스키의 개인 취급액 시계열 (충청남도)
Series: temp_ts
ARIMA(1,0,0)(1,1,0)[12]
Coefficients:
ar1 sar1
0.7534 -0.4463
s.e. 0.1067 0.1428
sigma^2 = 507225662264: log likelihood = -596.51
AIC=1199.03 AICc=1199.69 BIC=1204.09
Ljung-Box test
data: Residuals from ARIMA(1,0,0)(1,1,0)[12]
Q* = 5.2172, df = 8, p-value = 0.7341
Model df: 2. Total lags used: 10
자전거의 개인 취급액 시계열 (충청남도)
Series: temp_ts
ARIMA(0,1,1)(0,1,1)[12]
Coefficients:
ma1 sma1
-0.4460 -0.4469
s.e. 0.1765 0.2067
sigma^2 = 2378335129615: log likelihood = -611.45
AIC=1228.9 AICc=1229.59 BIC=1233.89
Ljung-Box test
data: Residuals from ARIMA(0,1,1)(0,1,1)[12]
Q* = 9.2939, df = 8, p-value = 0.3181
Model df: 2. Total lags used: 10
헬스의 개인 취급액 시계열 (충청남도)
Series: temp_ts
ARIMA(1,0,0) with non-zero mean
Coefficients:
ar1 mean
0.5164 46940436
s.e. 0.1227 1364402
sigma^2 = 24321107768372: log likelihood = -874.3
AIC=1754.6 AICc=1755.1 BIC=1760.46
Ljung-Box test
data: Residuals from ARIMA(1,0,0) with non-zero mean
Q* = 6.0666, df = 8, p-value = 0.6398
Model df: 2. Total lags used: 10


















LS0tCnRpdGxlOiAi7Iqk7Y+s7Lig7Zmc64+ZIOyLnOqzhOyXtCDrtoTshJ0iCnN1YnRpdGxlOiAi7Lap7LKt64Ko64+EIgphdXRob3I6ICLsnbTsnqzsmqkiCm91dHB1dDoKICBodG1sX25vdGVib29rOgogICAgdG9jOiB5ZXMKICAgIGNvZGVfZm9sZGluZzogImhpZGUiCi0tLQoKPHN0eWxlIHR5cGU9InRleHQvY3NzIj4KaDEudGl0bGUgewogIGZvbnQtc2l6ZTogMzBweDsKICB0ZXh0LWFsaWduOiBjZW50ZXI7Cn0KaDMuc3VidGl0bGUgewogIGZvbnQtc2l6ZTogMjBweDsKICB0ZXh0LWFsaWduOiBjZW50ZXI7Cn0KaDQuYXV0aG9yIHsgLyogSGVhZGVyIDQgLSBhbmQgdGhlIGF1dGhvciBhbmQgZGF0YSBoZWFkZXJzIHVzZSB0aGlzIHRvbyAgKi8KICAgIGZvbnQtc2l6ZTogMThweDsKICB0ZXh0LWFsaWduOiByaWdodDsKfQpib2R5ewogICBmb250LXNpemU6IDE3cHg7ICAjIGJvZHkgaXMgZm9yIG5vcm1hbCB0ZXh0Cn0KdGR7CiAgIGZvbnQtc2l6ZTogMTJweDsgICMgdGQgaXMgZm9yIHRhYmxlIGRhdGEKfQo8L3N0eWxlCgpcClwKXAoKYGBge3J9CmxpYnJhcnkoZnBwMikgICMg7Iuc6rOE7Je0IOu2hOyEneydhCDsnITtlZwg7Yyo7YKk7KeACmxpYnJhcnkoZ3JpZEV4dHJhKQp0aGVtZV9zZXQodGhlbWVfZ3JleShiYXNlX2ZhbWlseT0nTmFudW1Hb3RoaWMnKSkgICMgZ2dwbG90IO2VnOq4gCDquajsp5Ag67Cp7KeACm9wdGlvbnMoc2NpcGVuID0gOTk5KSAgIyB0byByZW1vdmUgc2NpZW50aWZpYyBub3RhdGlvbgpgYGAKClwKXAoKIyDsoITssrQg7Iqk7Y+s7LigIO2VnCDqt7jrprzsl5AKClwKCmBgYHtyfQpkaXIgPC0gIi9Vc2Vycy9qYWV5b25nbGVlL0RvY3VtZW50cy9Db2xsZWdlL1JTdHVkaW8vQ3VsdHVyZS9yZWFsX3Byb3Blcl90c19kYXRhL2NodW5nbmFtLyIKaXRlbXMgPC0gYygi6rOo7ZSEIiwi66CI7KCA7Iqk7Y+s7LigIiwi7Iqk7YKkIiwi7J6Q7KCE6rGwIiwi7Zes7IqkIikKCiMg642w7J207YSwIOu2iOufrOyYpOq4sAp0ZW1wMSA8LSByZWFkLmNzdihwYXN0ZShkaXIsaXRlbXNbMV0sIi5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQp0ZW1wMiA8LSByZWFkLmNzdihwYXN0ZShkaXIsaXRlbXNbMl0sIi5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQp0ZW1wMyA8LSByZWFkLmNzdihwYXN0ZShkaXIsaXRlbXNbM10sIi5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQp0ZW1wNCA8LSByZWFkLmNzdihwYXN0ZShkaXIsaXRlbXNbNF0sIi5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQp0ZW1wNSA8LSByZWFkLmNzdihwYXN0ZShkaXIsaXRlbXNbNV0sIi5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQoKIyB0cyDqsJzssrTroZwg66eM65Ok6riwCnRlbXAxX3RzIDwtIHRzKHRlbXAxWydhdmcnXVssMV0sIHN0YXJ0PTIwMTgsIGZyZXF1ZW5jeT0xMikgICMgWywxXeydgCB1bml2YXJpYXRl7Jy866GcIOygle2Zle2eiCDtlbTso7zquLAg7JyE7ZWo7J6ECnRlbXAyX3RzIDwtIHRzKHRlbXAyWydhdmcnXVssMV0sIHN0YXJ0PTIwMTgsIGZyZXF1ZW5jeT0xMikKdGVtcDNfdHMgPC0gdHModGVtcDNbJ2F2ZyddWywxXSwgc3RhcnQ9MjAxOCwgZnJlcXVlbmN5PTEyKQp0ZW1wNF90cyA8LSB0cyh0ZW1wNFsnYXZnJ11bLDFdLCBzdGFydD0yMDE4LCBmcmVxdWVuY3k9MTIpCnRlbXA1X3RzIDwtIHRzKHRlbXA1WydhdmcnXVssMV0sIHN0YXJ0PTIwMTgsIGZyZXF1ZW5jeT0xMikKCiMg7Iuc6rCB7ZmUCnRlbXBfcGxvdCA8LSBhdXRvcGxvdCh0ZW1wMV90cywgc2VyaWVzID0gaXRlbXNbMV0pICsKICBhdXRvbGF5ZXIodGVtcDJfdHMsIHNlcmllcyA9IGl0ZW1zWzJdKSArCiAgYXV0b2xheWVyKHRlbXAzX3RzLCBzZXJpZXMgPSBpdGVtc1szXSkgKwogIGF1dG9sYXllcih0ZW1wNF90cywgc2VyaWVzID0gaXRlbXNbNF0pICsKICBhdXRvbGF5ZXIodGVtcDVfdHMsIHNlcmllcyA9IGl0ZW1zWzVdKSArCiAgbGFicyh0aXRsZSA9IHBhc3RlKCLsiqTtj6zsuKAg7KKF66qp67OEIOqwnOyduCDst6jquInslaEg7Iuc6rOE7Je0ICjstqnssq3rgqjrj4QpXG4iLHNlcD0iIiksCiAgICAgICBjYXB0aW9uID0gIijqsJzsnbgg7Leo6riJ7JWhID0g64+Z7J28IOuFhOyblOydmCDst6jquInslaHsnZgg7ZWpIC8g7J207Jqp6rG07IiYKSIsCiAgICAgICB4ID0gIuyLnOqwhCIsCiAgICAgICB5ID0gIuy3qOq4ieyVoSIpICsKICBsYWJzKGNvbG9yPSfsiqTtj6zsuKAg7KKF66qpIOq1rOu2hCcpICsKICB0aGVtZSgKICAgIHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAwLjUpLCAjIOqwgOyatOuNsCDsoJXroKwKICAgIHBsb3QuY2FwdGlvbiA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDApICAjIOyZvOyqvSDsoJXroKwKICAgICkKcHJpbnQodGVtcF9wbG90KQpgYGAKClwKXAoKIyDsiqTtj6zsuKAg7KKF66qp67OEIOyLnOqzhOyXtCDrtoTtlbQg67CPIOyYiOy4oQoKXAoKYGBge3J9CmRpciA8LSAiL1VzZXJzL2phZXlvbmdsZWUvRG9jdW1lbnRzL0NvbGxlZ2UvUlN0dWRpby9DdWx0dXJlL3JlYWxfcHJvcGVyX3RzX2RhdGEvY2h1bmduYW0vIgppdGVtcyA8LSBjKCLsoITssrQg7Iqk7Y+s7Lig7Zmc64+ZIiwi6rOo7ZSEIiwi66CI7KCA7Iqk7Y+s7LigIiwi7Iqk7YKkIiwi7J6Q7KCE6rGwIiwi7Zes7IqkIikKCmZvcihpdGVtIGluIGl0ZW1zKXsKICAjIOuNsOydtO2EsCDrtojrn6zsmKTquLAKICBpZihpdGVtID09ICLsoITssrQg7Iqk7Y+s7Lig7Zmc64+ZIil7CiAgICB0ZW1wIDwtIHJlYWQuY3N2KHBhc3RlKGRpciwiYWxsX3Nwb3J0cy5jc3YiLHNlcD0iIiksIGhlYWRlcj1UKQogIH1lbHNlewogICAgdGVtcCA8LSByZWFkLmNzdihwYXN0ZShkaXIsaXRlbSwiLmNzdiIsc2VwPSIiKSwgaGVhZGVyPVQpCiAgfQogIAogICMgdHMg6rCc7LK066GcIOunjOuTpOq4sAogIHRlbXBfdHMgPC0gdHModGVtcFsnYXZnJ11bLDFdLCBzdGFydD0yMDE4LCBmcmVxdWVuY3k9MTIpICAjIFssMV3snYAgdW5pdmFyaWF0ZeycvOuhnCDsoJXtmZXtnogg7ZW07KO86riwIOychO2VqOyehAoKICAjIGF1dG8uYXJpbWHroZwg7LWc7KCB7J2YIHBkcSwgUERRIOywvuq4sAogIGZpdF9hcmltYSA8LSBhdXRvLmFyaW1hKHRlbXBfdHMpCiAgY2F0KHBhc3RlKGl0ZW0sIuydmCDqsJzsnbgg7Leo6riJ7JWhIOyLnOqzhOyXtCAo7Lap7LKt64Ko64+EKVxuIiwgc2VwPSIiKSkKICBwcmludChmaXRfYXJpbWEpCiAgCiAgIyByZXNpZHVhbCBhc3N1bXB0aW9uIO2ZleyduAogIGNoZWNrcmVzaWR1YWxzKGZpdF9hcmltYSkKICAKICBmaXRfYXJpbWEgJT4lIGZvcmVjYXN0KGg9MTIsIGxldmVsPTgwKSAlPiUgYXV0b3Bsb3QoKSArCiAgICBsYWJzKHRpdGxlID0gcGFzdGUoaXRlbSwi7J2YIOqwnOyduCDst6jquInslaEg7Iuc6rOE7Je0ICjstqnssq3rgqjrj4QpIixzZXA9IiIpLAogICAgICAgICBzdWJ0aXRsZSA9ICLrr7jrnpggMX4xMuqwnOyblCgx64WEKeyXkCDrjIDtlZwgQVJJTUHsnZgg7JiI7Lih7LmY7JmAIDgwJSDsi6DrorDqtazqsIQiLAogICAgICAgICBjYXB0aW9uID0gIijqsJzsnbgg7Leo6riJ7JWhID0g64+Z7J28IOuFhOyblOydmCDst6jquInslaHsnZgg7ZWpIC8g7J207Jqp6rG07IiYIiwKICAgICAgICAgeCA9ICLsi5zqsIQiLAogICAgICAgICB5ID0gIuy3qOq4ieyVoSIpICsKICAgIHRoZW1lKAogICAgICBwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41KSwgIyDqsIDsmrTrjbAg7KCV66CsCiAgICAgIHBsb3Quc3VidGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAwLjUpLAogICAgICBwbG90LmNhcHRpb24gPSBlbGVtZW50X3RleHQoaGp1c3QgPSAwKSAgIyDsmbzsqr0g7KCV66CsCiAgICAgICkgLT4gYXJpbWFfcGxvdAogIHByaW50KGFyaW1hX3Bsb3QpCiAgCiAgIyBTVEwgZGVjb21wb3NpdGlvbgogIGZpdF9zdGwgPC0gc3RsKHRlbXBfdHMscy53aW5kb3c9InBlcmlvZGljIiwgcm9idXN0PVQpCiAgYXV0b3Bsb3QoZml0X3N0bCkgKwogICAgbGFicyh0aXRsZSA9IHBhc3RlKGl0ZW0sIuydmCDqsJzsnbgg7Leo6riJ7JWhIOyLnOqzhOyXtCAo7Lap7LKt64Ko64+EKSIsc2VwPSIiKSwKICAgICAgICAgc3VidGl0bGUgPSAiU1RMIGRlY29tcG9zaXRpb24iLAogICAgICAgICBjYXB0aW9uID0gIijqsJzsnbgg7Leo6riJ7JWhID0g64+Z7J28IOuFhOyblOydmCDst6jquInslaHsnZgg7ZWpIC8g7J207Jqp6rG07IiYKSIsCiAgICAgICAgIHggPSAi7Iuc6rCEIiwKICAgICAgICAgeSA9ICLst6jquInslaEiKSArCiAgICB0aGVtZSgKICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSksICMg6rCA7Jq0642wIOygleugrAogICAgICBwbG90LnN1YnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41KSwKICAgICAgcGxvdC5jYXB0aW9uID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMCkgICMg7Jm87Kq9IOygleugrAogICAgICApIC0+IHN0bF9wbG90CiAgcHJpbnQoc3RsX3Bsb3QpCn0KYGBgCgpcClwKXAoKCgo=